home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 126-150 / disk_138 / modulatools / template / template.mod < prev    next >
Text File  |  1992-05-06  |  6KB  |  195 lines
  1. IMPLEMENTATION MODULE Template;
  2.  
  3. FROM InOut        IMPORT WriteString, WriteLn; 
  4. FROM Intuition    IMPORT Screen, ScreenPtr, ScreenFlags, ScreenFlagSet,
  5.                          Window, WindowPtr, WindowFlags, WindowFlagSet,
  6.                          SmartRefresh, IntuiMessage, IntuiMessagePtr,
  7.                          IDCMPFlags, IDCMPFlagSet;
  8. FROM Menus        IMPORT SetMenuStrip;
  9. FROM Screens      IMPORT CloseScreen, ShowTitle;
  10. FROM Strings      IMPORT String;
  11. FROM SYSTEM       IMPORT NULL;
  12. FROM Views        IMPORT Modes, ModeSet;
  13. FROM Windows      IMPORT CloseWindow;
  14.  
  15. FROM ColorTools   IMPORT SetScreenColors;
  16. FROM MenuTools    IMPORT AddMenu, AddItem, AddSubItem, DestroyMenuStrip,
  17.                          FirstMenu, NoKey, ItemOn, Checkable, CheckNow,
  18.                          AutoIndent, InitializeMenuStrip, HiResScreen, Left;
  19. FROM MessageTools IMPORT GotMessage, GetMenuChoice, ChoiceType;
  20. FROM TextTools    IMPORT FrontTextPen, BackTextPen;
  21. FROM WindowTools  IMPORT OpenGraphics,   CreateScreen, CreateWindow,   FillPen,
  22.                          CloseGraphics,  ViewFeatures, ScreenFeatures, TextPen,
  23.                          WindowFeatures, NoTitle, UserIntuiBase, UserGraphBase;
  24.  
  25.  
  26. CONST
  27.    ProjectMenu = 0;
  28.    QuitItem    = 6;
  29.  
  30. VAR
  31.    IMessage   : IntuiMessagePtr;
  32.    MenuChoice : ChoiceType;
  33.    finished   : BOOLEAN; 
  34.  
  35.  
  36.    PROCEDURE CreateCanvas () : BOOLEAN;
  37.  
  38.  
  39.       PROCEDURE OpenTheScreen () : BOOLEAN;
  40.  
  41.       VAR
  42.          ScreenTitle : String;
  43.  
  44.       BEGIN
  45.          ScreenTitle    := NoTitle;
  46.          ViewFeatures   := ModeSet{Hires};
  47.          ScreenFeatures := ScreenFlagSet{ScreenQuiet};
  48.          TheScreen      := CreateScreen (0,0,640,200, 3, ScreenTitle);
  49.          IF (TheScreen <> NULL) THEN
  50.             SetScreenColors(TheScreen);
  51.             RETURN TRUE;
  52.          ELSE
  53.             RETURN FALSE;
  54.          END; (* IF TheScreen *)
  55.       END OpenTheScreen;
  56.  
  57.  
  58.       PROCEDURE OpenTheWindow () : BOOLEAN;
  59.  
  60.       VAR
  61.          WindowTitle : String;
  62.  
  63.       BEGIN
  64.          WindowTitle    := NoTitle;
  65.          WindowFeatures := SmartRefresh + WindowFlagSet{Activate, Borderless,
  66.                                           BackDrop, ReportMouseFlag};
  67.          TheWindow      := CreateWindow (0,0,640,200, WindowTitle, TheScreen);
  68.          IF (TheWindow <> NULL) THEN
  69.             RETURN TRUE;
  70.          ELSE
  71.             RETURN FALSE;
  72.          END; (* IF TheScreen *)
  73.       END OpenTheWindow;
  74.  
  75.  
  76.    BEGIN
  77.  
  78.       IF ( OpenGraphics() ) THEN
  79.          IF ( OpenTheScreen() ) THEN
  80.  
  81.             IF ( OpenTheWindow () ) THEN
  82.                ShowTitle (TheScreen, FALSE);      (* don't show Screen title *)
  83.                RETURN TRUE;
  84.             ELSE
  85.                WriteLn; WriteString ("Couldn't allocate Window..."); WriteLn;
  86.                CloseScreen (TheScreen);
  87.                CloseGraphics;
  88.                RETURN FALSE;
  89.             END; (* IF OpenTheWindow *)
  90.  
  91.          ELSE
  92.             WriteLn; WriteString ("Couldn't allocate Screen..."); WriteLn;
  93.             CloseGraphics;
  94.             RETURN FALSE;
  95.          END; (* IF TheScreen *)
  96.  
  97.       ELSE
  98.          IF (UserIntuiBase = NULL) THEN
  99.             WriteLn; WriteString("Intuition library would not open."); WriteLn;
  100.          ELSE  (* UserGraphBase = NULL *)
  101.             WriteLn; WriteString("Graphics library would not open."); WriteLn;
  102.          END; (* IF UserIntuiBase *)
  103.          RETURN FALSE;
  104.       END; (* IF OpenGraphics *)
  105.  
  106.    END CreateCanvas;
  107.  
  108.  
  109.    PROCEDURE CreateMenuStrip;
  110.  
  111.    BEGIN
  112.  
  113.       InitializeMenuStrip;
  114.       HiResScreen  := TRUE;
  115.  
  116.       AddMenu ("Project");
  117.          AddItem ("New",          "N",   ItemOn, 0);
  118.          AddItem ("Open",         "O",   ItemOn, 0);
  119.          AddItem ("Save",         "S",   ItemOn, 0);
  120.          AddItem ("Save as..   ", "A",   ItemOn, 0);
  121.          AddItem ("Page setup..", NoKey, ItemOn, 0);
  122.          AddItem ("Print",        NoKey, ItemOn, 0);
  123.          AddItem ("Quit",         "Q",   ItemOn, 0);
  124.  
  125.       AddMenu ("Edit");
  126.          AddItem ("Undo",  "U", ItemOn, 0);
  127.          AddItem ("Cut",   "X", ItemOn, 0);
  128.          AddItem ("Copy",  "C", ItemOn, 0);
  129.          AddItem ("Paste", "P", ItemOn, 0);
  130.          AddItem ("Erase", "E", ItemOn, 0);
  131.  
  132.       AutoIndent := TRUE;
  133.       AddMenu ("Your Menu");
  134.          Left := -18;
  135.          AddItem ("Your Item", NoKey, ItemOn+Checkable+CheckNow, 63-1);
  136.          AddItem ("Your Item", NoKey, ItemOn,                    63-2);
  137.             AddSubItem ("Your SubItem", NoKey, ItemOn+Checkable, 2);
  138.             AddSubItem ("Your SubItem", NoKey, ItemOn+Checkable, 1);
  139.          AddItem ("Your Item", NoKey, ItemOn+Checkable,          63-4);
  140.          AddItem ("Your Item", NoKey, ItemOn,                    63-8);
  141.             AddSubItem ("Check Me!", NoKey, ItemOn+Checkable, 2+4+8);
  142.             AddSubItem ("Check Me!", NoKey, ItemOn+Checkable, 1+4+8);
  143.             AddSubItem ("Check Me!", NoKey, ItemOn+Checkable, 1+2+8);
  144.             AddSubItem ("Check Me!", NoKey, ItemOn+Checkable, 1+2+4);
  145.  
  146.    END CreateMenuStrip;
  147.  
  148.  
  149.    PROCEDURE CreateScreenWindowAndMenus () : BOOLEAN;
  150.  
  151.    BEGIN
  152.       IF ( CreateCanvas () ) THEN
  153.          CreateMenuStrip ();
  154.          SetMenuStrip (TheWindow, FirstMenu^);
  155.          TheMenu := FirstMenu;
  156.          RETURN TRUE;
  157.       ELSE
  158.          TheMenu := NULL;
  159.          RETURN FALSE;
  160.       END; (* IF CreateCanvas *)
  161.    END CreateScreenWindowAndMenus;
  162.  
  163.  
  164.    PROCEDURE ProcessIntuiMessages (VAR finished : BOOLEAN);
  165.  
  166.    BEGIN
  167.       WHILE (GotMessage (IMessage, TheWindow)) DO
  168.          IF (MenuPick IN IMessage^.Class) THEN
  169.  
  170.             GetMenuChoice (IMessage^.Code, FirstMenu, MenuChoice);
  171.             WITH MenuChoice DO
  172.                IF (MenuChosen = ProjectMenu) AND (ItemChosen = QuitItem) THEN
  173.                   finished := TRUE;
  174.                   RETURN;
  175.                END; (* IF MenuChosen *)
  176.             END; (* WITH MenuChoice *)
  177.  
  178.          END; (* IF MenuPick *)
  179.       END; (* WHILE GotMessage *) 
  180.    END ProcessIntuiMessages; 
  181.  
  182.  
  183.    PROCEDURE DestroyScreenWindowAndMenus;
  184.  
  185.    BEGIN
  186.       DestroyMenuStrip (TheWindow);
  187.       CloseWindow (TheWindow);
  188.       CloseScreen (TheScreen);
  189.       CloseGraphics ();
  190.    END DestroyScreenWindowAndMenus;
  191.  
  192.  
  193. BEGIN
  194. END Template.
  195.